home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / zbpc_460.zip / GRAPHICS.EXE / PYRAMID.BAS < prev    next >
BASIC Source File  |  1991-03-18  |  3KB  |  96 lines
  1. 00010 REM***********************************
  2. 00020 REM** PYRAMID    3D GRAPHIC PYRAMID **
  3. 00030 REM** CREATED 07/05/84 BY A.G.      **
  4. 00040 REM***********************************
  5. 00050 DEFDBL A-Z : DEFINT A,D,I,J,K : CLS : PRINT"Control - C to stop - - CALC.";
  6. 00060 DIM SP%(912),E%(6,3),V(4,3),SV%(4,2),S%(4,4),N(4,3)
  7. 00070 RH=15 : D=4000 : AD=1 : CX%=400 : CY%=500
  8. 00080 S1=SIN(.5) : C1=COS(.5) : S2=SIN(.9) : C2=COS(.9)
  9. 00090 CT=COS(.1) : ST=SIN(.1) : SO=SIN(-.1): CO=COS(-.1)
  10. 00100 SP=SIN(-.1): CP=COS(-.1)
  11. 00110 DATA   0, 0, 1.75
  12. 00120 DATA   1, 0, 0
  13. 00130 DATA -.2, 1, 0
  14. 00140 DATA -.2,-1, 0
  15. 00150 FOR I=1 TO 4
  16. 00160   READ X,Y,Z : V(I,1)=X : V(I,2)=Y : V(I,3)=Z : GOSUB 890
  17. 00170 NEXT
  18. 00180 DATA 1,4,2,1
  19. 00190 DATA 1,2,3,1
  20. 00200 DATA 1,3,4,1
  21. 00210 DATA 2,4,3,2
  22. 00220 FOR I=1 TO 4
  23. 00230   FOR J=1 TO 4
  24. 00240     READ S%(I,J)
  25. 00250   NEXT J
  26. 00260 NEXT I
  27. 00270 FOR IR = 1 TO 36
  28. 00280   FOR I=1 TO 6
  29. 00290     E%(I,3)=0
  30. 00300   NEXT I
  31. 00310   FOR I=1 TO 4
  32. 00320     U1=V(S%(I,2),1)-V(S%(I,1),1)
  33. 00330     U2=V(S%(I,2),2)-V(S%(I,1),2)
  34. 00340     U3=V(S%(I,2),3)-V(S%(I,1),3)
  35. 00350     V1=V(S%(I,3),1)-V(S%(I,1),1)
  36. 00360     V2=V(S%(I,3),2)-V(S%(I,1),2)
  37. 00370     V3=V(S%(I,3),3)-V(S%(I,1),3)
  38. 00380     N(I,1)=U2*V3-V2*U3:N(I,2)=U3*V1-V3*U1:N(I,3)=U1*V2-V1*U2
  39. 00390   NEXT I
  40. 00400   XE=RH*S2*C1 : YE=RH*S2*S1 : ZE=RH*C2
  41. 00410   N%=1
  42. 00420   FOR I=1 TO 4
  43. 00430     E2%=S%(I,1)
  44. 00440     WX=XE-V(E2%,1) : WY=YE-V(E2%,2) : WZ=ZE-V(E2%,3)
  45. 00450     LONG IF N(I,1)*WX+N(I,2)*WY+N(I,3)*WZ > 0
  46. 00460       E1%=S%(I,1)
  47. 00470       FOR J=2 TO 4
  48. 00480         E2%=S%(I,J)
  49. 00490         FOR K=1 TO N%
  50. 00500           IF E%(K,1)=E2% AND E%(K,2)=E1% THEN E%(K,3)=2 : GOTO 540
  51. 00510         NEXT K
  52. 00520         E%(N%,1)=E1% : E%(N%,2)=E2% : E%(N%,3)=1
  53. 00530         N%=N%+1
  54. 00540         E1%=E2%
  55. 00550       NEXT J
  56. 00560     END IF
  57. 00570   NEXT I
  58. 00580   FOR I=1 TO 6
  59. 00590     LONG IF E%(I,3)
  60. 00600       J=E%(I,1) : K=E%(I,2)
  61. 00610       SP%(AD  )=SV%(J,1) : SP%(AD+1)=SV%(J,2)
  62. 00620       SP%(AD+2)=SV%(K,1) : SP%(AD+3)=SV%(K,2)
  63. 00630     END IF
  64. 00640     AD=AD+4
  65. 00650   NEXT
  66. 00660   FOR I=1 TO 4
  67. 00670     T1=CP*CT*V(I,1)-(ST*CP+SO*SP)*V(I,2)+(SO*ST*CP-SP*CO)*V(I,3)
  68. 00680     T2=ST*V(I,1)+CO*CT*V(I,2)-SO*CT*V(I,3)
  69. 00690     T3=SP*CT*V(I,1)+(SO*CP-CO*ST*SP)*V(I,2)+(ST*SO*SP+CO*CP)*V(I,3)
  70. 00700     V(I,1)=T1 : V(I,2)=T2 : V(I,3)=T3 : X=T1 : Y=T2 : Z=T3
  71. 00710     GOSUB 890
  72. 00720   NEXT
  73. 00730   TRON B:TROFF:PRINT"*";
  74. 00740 NEXT
  75. 00750 FOR I=1 TO 48
  76. 00760   SP%(I+864)=SP%(I)
  77. 00770 NEXT I
  78. 00780 AD=1 : M=M+1 : IF M > 23 THEN M=0
  79. 00785 MODE M : PRINT @(0,0) "MODE";M : PRINT TIME$
  80. 00790 COLOR ASC("*")  : GOSUB 820: COLOR 0 : AD=AD-24 : GOSUB 820
  81. 00800 TRON X:IF AD=865 THEN 780
  82. 00810 GOTO 790
  83. 00820 FOR I=1 TO 6
  84. 00830   LONG IF SP%(AD)
  85. 00840     PLOT SP%(AD),SP%(AD+1) TO SP%(AD+2),SP%(AD+3)
  86. 00850   END IF
  87. 00860   AD=AD+4
  88. 00870 NEXT
  89. 00880 RETURN
  90. 00890 XE=-X*S1+Y*C1
  91. 00900 YE=-X*C1*C2-Y*S1*C2+Z*S2
  92. 00910 ZE=-X*S2*C1-Y*S2*S1-Z*C2+RH
  93. 00920 SV%(I,1)= D*XE/ZE+CX%
  94. 00930 SV%(I,2)=-D*YE/ZE+CY%
  95. 00940 RETURN
  96.